home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
drawal1r
/
form1.frm
next >
Wrap
Text File
|
1999-08-15
|
8KB
|
318 lines
VERSION 4.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Caption = "Form1"
ClientHeight = 6945
ClientLeft = 0
ClientTop = 315
ClientWidth = 9660
ClipControls = 0 'False
ControlBox = 0 'False
Height = 7380
Left = -60
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7500
ScaleMode = 0 'User
ScaleWidth = 9660
Top = -60
Width = 9780
Begin VB.PictureBox picEdit
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
Height = 7593
Left = 0
ScaleHeight = 8200
ScaleMode = 0 'User
ScaleWidth = 9645
TabIndex = 0
Top = -45
Width = 9705
Begin VB.PictureBox picHid
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Height = 7530
Left = 150
ScaleHeight = 8200
ScaleMode = 0 'User
ScaleWidth = 1125
TabIndex = 1
Top = 510
Visible = 0 'False
Width = 1125
End
End
Begin MSComDlg.CommonDialog CommonDialog1
Left = 4230
Top = 3225
_ExtentX = 847
_ExtentY = 847
_Version = 327681
DialogTitle = "Load Picture"
Filter = "Pictures *.bmp |*.bmp"
InitDir = "C:\"
End
Begin VB.Menu mnuMain
Caption = "Main"
Visible = 0 'False
Begin VB.Menu mnuLoad
Caption = "Load"
End
Begin VB.Menu mnuClear
Caption = "Clear"
End
Begin VB.Menu mnuTrim
Caption = "Trim"
End
Begin VB.Menu mnuCopy
Caption = "Copy"
End
Begin VB.Menu mnuPaste
Caption = "Paste"
End
Begin VB.Menu mnuSize
Caption = "Size"
Begin VB.Menu mnu1p1X
Caption = "1.1X"
End
Begin VB.Menu mnu1p2X
Caption = "1.2X"
End
Begin VB.Menu mnu1p3X
Caption = "1.3X"
End
Begin VB.Menu mnu1p5X
Caption = "1.5X"
End
Begin VB.Menu mnu2X
Caption = "2X"
End
Begin VB.Menu mnu3X
Caption = "3X"
End
Begin VB.Menu mnu4X
Caption = "4X"
End
End
Begin VB.Menu mnuReload
Caption = "Reload"
End
Begin VB.Menu mnuSave
Caption = "Save"
End
Begin VB.Menu mnuExit
Caption = "Exit"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private x1 As Single
Private y1 As Single
Private x2 As Single
Private y2 As Single
Private Drag As Boolean
Private Sub Resize(Size As Single)
Dim w As Single
Dim h As Single
w = picHid.ScaleWidth * Size
h = picHid.ScaleHeight * Size
picEdit.Cls
On Error Resume Next
picEdit.PaintPicture picHid.Picture, 0, 0, w, h, 0, 0, picHid.ScaleWidth, picHid.ScaleHeight
picEdit.Picture = picEdit.Image
End Sub
Private Sub Swap()
Dim var As Single
If x1 > x2 Then
var = x1
x1 = x2
x2 = var
End If
If y1 > y2 Then
var = y1
y1 = y2
y2 = var
End If
End Sub
Private Sub mnu1p1X_Click()
Resize 1.1
End Sub
Private Sub mnu1p2X_Click()
Resize 1.2
End Sub
Private Sub mnu1p3X_Click()
Resize 1.3
End Sub
Private Sub mnu1p5X_Click()
Resize 1.5
End Sub
Private Sub mnu2X_Click()
Resize 2
End Sub
Private Sub mnu3X_Click()
Resize 3
End Sub
Private Sub mnu4X_Click()
Resize 4
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuReload_Click()
Dim lRtn As Long
lRtn = LoadImage(App.hInstance, CommonDialog1.filename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
Set picEdit.Picture = MoveBitmap(lRtn)
End Sub
Private Sub mnuLoad_Click()
CommonDialog1.Action = 1
Dim lRtn As Long
lRtn = LoadImage(App.hInstance, CommonDialog1.filename, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE Or LR_LOADMAP3DCOLORS)
Set picEdit.Picture = MoveBitmap(lRtn)
End Sub
Private Sub mnuSave_Click()
If Not Clipboard.GetFormat(vbCFBitmap) Then Exit Sub
Dim dat As OPENFILENAME
dat.lStructSize = Len(dat)
dat.hwndOwner = Form1.hwnd
dat.hInstance = App.hInstance
dat.lpstrFilter = "Pictures (*.bmp)" + Chr$(0) + "*.bmp"
dat.nMaxFileTitle = 255
dat.lpstrInitialDir = "C:\"
dat.lpstrTitle = "Save Picture"
dat.lpstrFile = Space$(254)
dat.nMaxFile = 255
dat.lpstrFileTitle = Space$(254)
dat.flags = 0
dat.lpstrFile = "C:\ClipPic.bmp"
Dim a As Long
a = GetSaveFileName(dat)
If (a) Then
SavePicture Clipboard.GetData(vbCFBitmap), Trim$(dat.lpstrFile)
End If
End Sub
Private Sub mnuTrim_Click()
Swap 'If necessary
picHid.Width = x2 - x1 + 1
picHid.Height = y2 - y1 + 1
On Error Resume Next
picHid.PaintPicture picEdit.Picture, 0, 0, x2 - x1 + 1, y2 - y1, x1, y1, x2 - x1 + 1, y2 - y1 + 1
Clipboard.Clear
Clipboard.SetData picHid.Image, vbCFBitmap
picEdit.Picture = LoadPicture(vbNullString)
If Not Clipboard.GetFormat(vbCFBitmap) Then Exit Sub
picHid.Picture = Clipboard.GetData(vbCFBitmap)
picEdit.PaintPicture picHid.Picture, x1, y1, picHid.ScaleWidth, picHid.ScaleHeight, 0, 0, picHid.ScaleWidth, picHid.ScaleHeight
picEdit.Picture = picEdit.Image
End Sub
Private Sub mnuPaste_Click()
If Not Clipboard.GetFormat(vbCFBitmap) Then Exit Sub
Swap
picHid.AutoSize = True
picHid.Picture = Clipboard.GetData(vbCFBitmap)
picHid.AutoSize = False
picEdit.PaintPicture picHid.Picture, x1, y1, picHid.ScaleWidth, picHid.ScaleHeight, 0, 0, picHid.ScaleWidth, picHid.ScaleHeight
picEdit.Picture = picEdit.Image
End Sub
Private Sub mnuClear_Click()
picEdit.Picture = LoadPicture(vbNullString)
End Sub
Private Sub mnuCopy_Click()
Swap ' If necessary
picHid.Width = x2 - x1 + 1
picHid.Height = y2 - y1 + 1
On Error Resume Next
picHid.PaintPicture picEdit.Picture, 0, 0, x2 - x1 + 1, y2 - y1 + 1, x1, y1, x2 - x1 + 1, y2 - y1 + 1
picHid.Picture = picHid.Image 'To be sure it redraws
Clipboard.Clear
Clipboard.SetData picHid.Image, vbCFBitmap
End Sub
Private Sub mnuMain_Click()
mnuPaste.Enabled = Clipboard.GetFormat(vbCFBitmap)
End Sub
Private Sub picEdit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not Drag Then Exit Sub
picEdit.Line (x1, y1)-(x2, y2), , B
x2 = X
y2 = Y
picEdit.Line (x1, y1)-(x2, y2), , B
End Sub
Private Sub picEdit_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> vbLeftButton Then Exit Sub
Drag = True
picEdit.DrawMode = vbInvert
x1 = X
y1 = Y
x2 = X
y2 = Y
picEdit.Cls
picEdit.Line (X, Y)-(X, Y), , B
End Sub
Private Sub picEdit_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu mnuMain
Exit Sub
End If
If Not Drag Then Exit Sub
Drag = False
picEdit.DrawMode = vbCopyPen
End Sub
Private Sub Form_Load()
Title Me, False
End Sub